home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / psstk101.zip / STACK.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-18  |  3KB  |  169 lines
  1. {
  2.  
  3.                                                       ╔══════════════════╗
  4.                                                       ║    Stack Unit    ║
  5.                                                       ║  (Simple Array)  ║
  6.                                                       ║    Rev. 1.01     ║
  7.                                                       ╚══════════════════╝
  8.  
  9. }
  10.  
  11. {$F-} {$O-} {$A+} {$G-}
  12. {$V-} {$B-} {$X-} {$N+} {$E+}
  13.  
  14. {$I FINAL.PAS}
  15.  
  16. {$IFDEF FINAL}
  17.   {$I-} {$R-}
  18.   {$D-} {$L-} {$S-}
  19. {$ENDIF}
  20.  
  21. Unit Stack;
  22.  
  23. Interface
  24.  
  25. Const
  26.   MaxData      = 100;
  27.  
  28. Type
  29.  
  30.   Data         = LongInt;
  31.   StackArray   = Array [1..MaxData] of Data;
  32.  
  33.   DataStack = Object
  34.  
  35.                 Procedure Init;
  36.                 Function  Empty        :Boolean;
  37.                 Function  Full         :Boolean;
  38.                 Procedure Push(    Item:Data);
  39.                 Procedure Pop (Var Item:Data);
  40.                 Procedure Top (Var Item:Data);
  41.                 Procedure Drop;
  42.                 Procedure Destroy;
  43.  
  44.               Private
  45.  
  46.                 StackData:StackArray;
  47.                 StackPtr :Word;
  48.  
  49.               {$IFDEF NOTFINAL}
  50.  
  51.                 Procedure Error(Num:Byte);
  52.  
  53.               {$ENDIF}
  54.  
  55.               End;
  56.  
  57. Implementation
  58.  
  59. {Include Error Checking if Debug Information is Required}
  60.  
  61. {$IFDEF NOTFINAL}
  62.  
  63. Procedure DataStack.Error(Num:Byte);
  64. Begin
  65.  
  66.   WriteLn;
  67.   Write('Runtime Error Stack-',Num,'  ');
  68.  
  69.   Case Num Of
  70.     1:Write('Stack Overflow');
  71.     2:Write('Stack Underflow');
  72.   End;
  73.  
  74.   WriteLn('.');
  75.  
  76.   Halt;
  77. End;
  78.  
  79. {$ENDIF}
  80.  
  81. Procedure DataStack.Init;
  82. Begin
  83.   StackPtr:=0;
  84. End;
  85.  
  86. Function DataStack.Empty:Boolean;
  87. Begin
  88.   If StackPtr=0 Then
  89.     Empty:=True
  90.   Else
  91.     Empty:=False;
  92. End;
  93.  
  94. Function DataStack.Full:Boolean;
  95. Begin
  96.   If StackPtr=MaxData Then
  97.     Full:=True
  98.   Else
  99.     Full:=False;
  100. End;
  101.  
  102. Procedure DataStack.Push(Item:Data);
  103. Begin
  104.  
  105.   {$IFDEF NOTFINAL}
  106.  
  107.     If Full Then Error(1);
  108.  
  109.   {$ENDIF}
  110.  
  111.   Inc(StackPtr);
  112.   StackData[StackPtr]:=Item;
  113. End;
  114.  
  115. Procedure DataStack.Pop(Var Item:Data);
  116. Begin
  117.  
  118.   {$IFDEF NOTFINAL}
  119.  
  120.     If Empty Then Error(2);
  121.  
  122.   {$ENDIF}
  123.  
  124.   Item:=StackData[StackPtr];             {Could Top and Drop, but
  125.                                           this is much faster}
  126.   Dec(StackPtr);
  127. End;
  128.  
  129. Procedure DataStack.Top(Var Item:Data);
  130. Begin
  131.  
  132.   {$IFDEF NOTFINAL}
  133.  
  134.     If Empty Then Error(2);
  135.  
  136.   {$ENDIF}
  137.  
  138.   Item:=StackData[StackPtr];
  139. End;
  140.  
  141. Procedure DataStack.Drop;
  142. Begin
  143.  
  144.   {$IFDEF NOTFINAL}
  145.  
  146.     If Empty Then Error(2);
  147.  
  148.   {$ENDIF}
  149.  
  150.   Dec(StackPtr);
  151. End;
  152.  
  153. Procedure DataStack.Destroy;
  154. Begin
  155.   StackPtr:=0;          {Clears the stack.  Happens to be the same as Init in}
  156. End;                    {this particular implementation.}
  157.  
  158. End.
  159.  
  160. {
  161. ╔══════════════════════════════════════════════════════════════╗
  162. ║                   Pure Power Software                        ║
  163. ╟──────────────────────────────────────────────────────────────╢
  164. ║                                                              ║
  165. ║       This  software  is copyright by Michael Gallias.       ║
  166. ║                                                              ║
  167. ╚══════════════════════════════════════════════════════════════╝
  168. }
  169.